VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsXMLSettings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'+
'Project Name:  FSMSClient
'Host Name:     FSMSClient.clsXMLSettings
'Date:          2005-12-22
'
' Encapsulate an XML document to hold program settings and history.
' These settings are saved in the 'exe' folder, so may or may not be shared to the installation.
'
' 2005-12-21, JFW, 4.00, New module.
' 2006-09-15, JFW, Copied from FCIL to FXI class.
' 2007-04-26, JFW, Copied from FXI to FSMS Client.
' 2007-04-26, JFW, Settings with name beginning '_' are copied to History section.

'~

Option Explicit

Dim xmlDoc As DOMDocument ' MSXML2.DOMDocument ' FSIX.Document
Dim xmlNode As IXMLDOMElement
Dim m_strFileName As String
Dim m_strHistoryKey As String
'


Public Function MakeNode(strNodeName As String, NodeValue As Variant) As IXMLDOMElement

    Dim objDocument As New MSXML2.DOMDocument
    Set MakeNode = objDocument.createElement(strNodeName)
    MakeNode.Text = NodeValue

End Function
'

Public Sub OpenSettings(strFileName As String)

    On Error GoTo ErrorExit
    
    m_strFileName = strFileName
    Set xmlDoc = New DOMDocument ' MSXML2.DOMDocument ' xml.CreateDocument("c:\" & Manifest.MasterShipment(1).MasterShipmentID & ".xml")
    If Not xmlDoc.Load(App.Path & "\" & m_strFileName & ".xml") Then
        Set xmlDoc = New DOMDocument
        Set xmlNode = xmlDoc.createElement(strFileName)
        xmlDoc.appendChild xmlNode
        xmlNode.appendChild MakeNode("LastModified", Format(Now, "yyyy-mm-dd HH:mm:ss"))
        xmlNode.appendChild xmlDoc.createElement("Settings")
        xmlNode.appendChild xmlDoc.createElement("History")
    End If

    Exit Sub
    
ErrorExit:
    Err.Raise 12345, "Settings.OpenSettings", Err.Source & " - " & Err.Description

End Sub

Public Sub PurgeHistory(dtPurge As Date)

    On Error GoTo ErrorExit
    
    Dim xmlnode1 As IXMLDOMNode
    
    If Not xmlDoc.firstChild.selectSingleNode("History") Is Nothing Then
    For Each xmlnode1 In xmlDoc.firstChild.selectSingleNode("History").childNodes
        If Not xmlnode1.selectSingleNode("LastModified") Is Nothing Then
            If IsDate(xmlnode1.selectSingleNode("LastModified").Text) Then
                If dtPurge > CDate(xmlnode1.selectSingleNode("LastModified").Text) Then
                    ' xmlDoc.removeChild (xmlnode1)
                    Call xmlDoc.firstChild.selectSingleNode("History").removeChild(xmlnode1)
                End If
            End If
        End If
    Next xmlnode1
    End If
    
    Exit Sub
    
ErrorExit:
    Err.Raise 12345, "Settings.PurgeHistory", Err.Source & " - " & Err.Description

End Sub

Public Sub SaveSettings()
    
    On Error GoTo ErrorExit
    
    xmlDoc.Save (App.Path & "\" & m_strFileName & ".xml")

    Exit Sub
    
ErrorExit:
    Err.Raise 12345, "Settings.SaveSettings", Err.Source & " - " & Err.Description

End Sub
    
    
Public Sub SaveHistory(strHistoryKey As String)

    Dim xmlnode1 As IXMLDOMElement
    
    Set xmlNode = xmlDoc.firstChild.selectSingleNode("History")
    If xmlNode Is Nothing Then
        Set xmlNode = xmlDoc.firstChild.appendChild(xmlDoc.createElement("History"))
    End If
    
    If Not xmlNode.selectSingleNode(strHistoryKey) Is Nothing Then
        xmlNode.removeChild xmlNode.selectSingleNode(strHistoryKey)
    End If
    
    Set xmlNode = xmlNode.appendChild(xmlDoc.createElement(strHistoryKey))
    
    For Each xmlnode1 In xmlDoc.firstChild.selectSingleNode("Settings").childNodes
        ' Settings with name beginning '_' are copied to History section
        If Left(xmlnode1.nodeName, 1) = "_" Then
            xmlNode.appendChild xmlnode1.cloneNode(True)
        End If
    Next xmlnode1
    xmlNode.appendChild MakeNode("LastModified", Format(Now, "yyyy-mm-dd HH:mm:ss"))
    
    Exit Sub
    
ErrorExit:
    Err.Raise 12345, "Settings.SaveHistory", Err.Source & " - " & Err.Description

End Sub


Public Property Get HistoryKey() As String
    HistoryKey = m_strHistoryKey
End Property

Public Property Let HistoryKey(strNewValue As String)
    m_strHistoryKey = strNewValue
End Property


Public Property Get Setting(strKeyName As String) As Variant
    On Error GoTo EmptySetting
    
    Set xmlNode = Nothing
    If m_strHistoryKey <> "" _
    And Left(strKeyName, 1) <> "_" Then
        Set xmlNode = xmlDoc.firstChild.selectSingleNode("History")
        If xmlNode Is Nothing Then
            Set xmlNode = xmlDoc.firstChild.appendChild(xmlDoc.createElement("History"))
        End If
        Set xmlNode = xmlNode.selectSingleNode("ID" & m_strHistoryKey)
    End If
    If xmlNode Is Nothing Then
        Set xmlNode = xmlDoc.firstChild.selectSingleNode("Settings")
        If xmlNode Is Nothing Then
            Set xmlNode = xmlDoc.firstChild.appendChild(xmlDoc.createElement("Settings"))
        End If
    End If
    
    Set xmlNode = xmlNode.selectSingleNode(strKeyName)
    If Not xmlNode Is Nothing Then
        Setting = xmlNode.Text
    End If
    Exit Property

EmptySetting:
    Err.Raise 12345, "Settings.Setting", Err.Source & " - " & Err.Description

End Property

Public Property Let Setting(strKeyName As String, varValue As Variant)
    On Error GoTo EmptySetting
    
    Set xmlNode = xmlDoc.firstChild.selectSingleNode("Settings")
    If xmlNode Is Nothing Then
        Set xmlNode = xmlDoc.firstChild.appendChild(xmlDoc.createElement("Settings"))
    End If
    Set xmlNode = xmlNode.selectSingleNode(strKeyName)
    If xmlNode Is Nothing Then
        Set xmlNode = xmlDoc.firstChild.selectSingleNode("Settings").appendChild(xmlDoc.createElement(strKeyName))
    End If
    xmlNode.Text = varValue
    
    Set xmlNode = xmlDoc.firstChild.selectSingleNode("LastModified")
    If xmlNode Is Nothing Then
        Set xmlNode = xmlDoc.firstChild.selectSingleNode("Settings").appendChild(xmlDoc.createElement("LastModified"))
    End If
    xmlNode.Text = Format(Now, "yyyy-mm-dd HH:mm:ss")
    
    Exit Property

EmptySetting:
    Err.Raise 12345, "Settings.Setting", Err.Source & " - " & Err.Description
    
End Property





